home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
TOOLBOX
/
TOOLBOX.PAS
next >
Wrap
Pascal/Delphi Source File
|
1992-02-25
|
11KB
|
274 lines
Unit ToolBox;
{**********************************************************}
{ ToolBox.pas by David Radecki (CIS: 72330,2255) }
{ }
{ This unit builds a toolbox similar to that found in }
{ Borland's Resource Workshop Dialog Editor. The code }
{ is my own, but it was greatly influenced by several }
{ examples I found in the Borland ProgA library, in }
{ addition to an article in Windows Tech Journal }
{ (Premiere Issue) by Richard A. Levaro "A Perfect Fit". }
{ It was a great help. This unit is not exactly a clinic }
{ in TPW or object-oriented coding, more like a first }
{ stab at custom control development. I would appreciate }
{ any comments (good or bad), constructive criticism is }
{ welcomed. This code is hereby donated to the Public }
{ Domain. }
{ }
{ The idea behind this unit is quite simple. Toolbox }
{ builds a child window, and paints it with the bitmaps }
{ supplied to it by the Toolbox Init constructor. The }
{ bitmaps and all ancillary information (bitmap sizes, }
{ position inside the window, and button state) is stored }
{ in a collection. The only parameters needed for the }
{ collection initialization are the two bitmap names for }
{ the up and down position respectively. The collection }
{ initialization call needs to contain at least the }
{ number of Insert statements made for the button }
{ collection as shown below: }
{ }
{ constructor TToolDemo.Init(AParent:PWindowsObject; }
{ ATitle:PChar); }
{ begin }
{ collection := New(PCollection,Init(# of Buttons,0)); }
{ with collection^ do }
{ begin }
{ Insert(New(PToolButton,Init(Button1a,Button1b))); }
{ Number of insert stmts match number of buttons }
{ declared in init statement }
{ end; }
{ TToolBox.Init(AParent,ATitle,Rows,Cols,DefaultButton,}
{ X-Position,Y-Position); }
{ end; }
{ }
{ Remember that I have supplied no button shading, that }
{ is up to the responsible button designer. }
{ }
{ In the window Init procedure, make sure to include the }
{ TToolBox.Init call. The parameters include the window's}
{ parent pointer, the ToolBox's title, the number of }
{ button rows, the number of button columns, the default }
{ depressed button, and the x and y position within the }
{ parent window. }
{ }
{ The implementation of the button selection is simple. }
{ As shown in the demo program the ButtonHit procedure }
{ is called through the tb_buttonhit message. The }
{ DepressedButton could be "cased" off of to call the }
{ desired procedure. }
{ }
{ Hope you enjoy this unit. }
{ }
{**********************************************************}
interface
uses WObjects, WinTypes, WinProcs, Strings;
const
Black_Border = 2;
Gray_Border = 5;
Up = 0;
Down = 1;
tb_buttonhit = wm_User + 500;
type
PToolButton = ^TToolButton;
TToolButton = object(TCollection)
ButtonHandle : array [Up..Down] of hBitmap;
ButtonName : array [Up..Down] of PChar;
ButtonRec : TBitmap;
ButtonSpec : TRect;
ButtonState : Integer;
constructor Init(UpButtonName, DownButtonName : PChar);
destructor Done; virtual;
end;
PToolBox = ^TToolBox;
TToolBox = object(TWindow)
DepressedButton,
MaxBottom,
MaxRight : Integer;
ToolCollection : PCollection;
MemDC : hDC;
SysMenuH : hMenu;
constructor Init(AParent: PWindowsObject; ATitle: PChar;
RowButtonDim, ColButtonDim, DefaultDepress,
XPosition,YPosition : Integer);
procedure Paint(PaintDC : hDC; var PaintInfo : TPaintStruct); virtual;
procedure WMLButtonDown (var Msg : TMessage); virtual wm_First + wm_LButtonDown;
procedure SetupWindow; virtual;
end;
{************************************************************************}
implementation
constructor TToolButton.Init(UpButtonName, DownButtonName : PChar);
begin
ButtonName[Up] := StrNew(UpButtonName);
ButtonHandle[Up] := LoadBitmap(hInstance,ButtonName[Up]);
ButtonName[Down] := StrNew(DownButtonName);
ButtonHandle[Down] := LoadBitmap(hInstance,ButtonName[Down]);
ButtonState := Up;
GetObject(ButtonHandle[Up],Sizeof(TBitmap),@ButtonRec);
end;
destructor TToolButton.Done;
begin
StrDispose(ButtonName[Up]);
DeleteObject(ButtonHandle[Up]);
StrDispose(ButtonName[Down]);
DeleteObject(ButtonHandle[Down]);
end;
{************************************************************************}
constructor TToolBox.Init(AParent: PWindowsObject; ATitle: PChar;
RowButtonDim, ColButtonDim, DefaultDepress,
XPosition,YPosition : Integer);
var
DisplayRow,
DisplayCol,
BitmapNum,
ButtonIndex : Integer;
procedure SetupButtonSpecs(SingleButton : PToolButton); far;
begin
BitmapNum := ToolCollection^.IndexOf(SingleButton);
DisplayRow := BitmapNum div ColButtonDim;
DisplayCol := BitmapNum mod ColButtonDim;
with SingleButton^ do
begin
ButtonSpec.Top := Gray_Border + Black_Border + (DisplayRow * Black_Border) +
(DisplayRow * ButtonRec.BMHeight);
ButtonSpec.Left := Gray_Border + Black_Border + (DisplayCol * Black_Border) +
(DisplayCol * ButtonRec.BMWidth);
ButtonSpec.Bottom := ButtonRec.BMHeight + ButtonSpec.Top;
ButtonSpec.Right := ButtonRec.BMWidth + ButtonSpec.Left;
if ButtonIndex = (DefaultDepress - 1)
then begin
ButtonState := Down;
DepressedButton := ButtonIndex;
end;
if BitmapNum = 0
then begin
MaxBottom := ButtonSpec.Bottom;
MaxRight := ButtonSpec.Right;
end
else begin
if ButtonSpec.Bottom > MaxBottom
then MaxBottom := ButtonSpec.Bottom;
if ButtonSpec.Right > MaxRight
then MaxRight := ButtonSpec.Right;
end;
end;
ToolCollection^.AtPut(ButtonIndex,SingleButton);
Inc(ButtonIndex);
end;
begin
TWindow.Init(AParent, ATitle);
SetFlags(wb_MDIChild,False);
ButtonIndex := 0;
DepressedButton := -1;
ToolCollection^.ForEach(@SetupButtonSpecs);
with Attr do
begin
Style := ws_Child or ws_Visible or ws_Overlapped or ws_ClipSiblings or ws_Caption
or ws_SysMenu and not ws_MaximizeBox and not ws_MinimizeBox;
W := MaxRight + (GetSystemMetrics(sm_CXBorder) * 2) +
Gray_Border + Black_Border;
H := MaxBottom + GetSystemMetrics(sm_CYBorder) +
GetSystemMetrics(sm_CYCaption) + Gray_Border + Black_Border;
X := XPosition;
Y := YPosition;
end;
end;
procedure TToolBox.SetupWindow;
begin
SysMenuH := GetSystemMenu(HWindow,false);
DeleteMenu(SysMenuH,8,mf_ByPosition);
DeleteMenu(SysMenuH,7,mf_ByPosition);
DeleteMenu(SysMenuH,6,mf_ByPosition);
DeleteMenu(SysMenuH,5,mf_ByPosition);
DeleteMenu(SysMenuH,4,mf_ByPosition);
DeleteMenu(SysMenuH,3,mf_ByPosition);
DeleteMenu(SysMenuH,2,mf_ByPosition);
DeleteMenu(SysMenuH,0,mf_ByPosition);
end;
procedure TToolBox.Paint(PaintDC : hDC; var PaintInfo : TPaintStruct);
var
hdcMem : hDC;
hToolBarBitmap : hBitmap;
ToolBoxRect : TRect;
procedure DisplayButtons(SingleButton : PToolButton); far;
begin
SelectObject(MemDC,SingleButton^.ButtonHandle[SingleButton^.ButtonState]);
BitBlt(hdcMem,SingleButton^.ButtonSpec.Left,SingleButton^.ButtonSpec.Top,
SingleButton^.ButtonRec.BMWidth,SingleButton^.ButtonRec.BMHeight,
MemDC,0,0,SrcCopy);
end;
begin
TWindow.Paint(PaintDC, PaintInfo);
GetClientRect(HWindow, ToolBoxRect);
hdcMem := CreateCompatibleDC(PaintDC);
hToolBarBitmap := CreateCompatibleBitmap(PaintDC,ToolBoxRect.Right,ToolBoxRect.Bottom);
SelectObject(hdcMem,hToolBarBitmap);
SetMapMode(hdcMem,GetMapMode(PaintDC));
FillRect(hdcMem,ToolBoxRect,GetStockObject(ltgray_brush));
InflateRect(ToolBoxRect,-Gray_Border,-Gray_Border);
FillRect(hdcMem,ToolBoxRect,GetStockObject(black_brush));
InflateRect(ToolBoxRect,Gray_Border,Gray_Border);
MemDC := CreateCompatibleDC(PaintDC);
ToolCollection^.ForEach(@DisplayButtons);
BitBlt(PaintDC,0,0,ToolBoxRect.Right,ToolBoxRect.Bottom,hdcMem,0,0,SrcCopy);
DeleteDC(MemDC);
DeleteDC(hdcMem);
DeleteObject(hToolBarBitmap);
end;
procedure TToolBox.WMLButtonDown (var Msg : TMessage);
var
HotPoint : TPoint;
ButtonCheck : PToolButton;
ButtonCount : Integer;
function ClickInButton(SingleButton : PToolButton) : Boolean; far;
begin
ClickInButton := PtInRect(SingleButton^.ButtonSpec, HotPoint) <> False;
Inc(ButtonCount);
end;
begin
ButtonCount := -1;
HotPoint.X := Msg.LParamLo;
HotPoint.Y := Msg.LParamHi;
ButtonCheck := ToolCollection^.FirstThat(@ClickInButton);
if ButtonCheck <> nil
then begin
if ButtonCount <> DepressedButton
then begin
ButtonCheck^.ButtonState := Down;
ToolCollection^.AtPut(ButtonCount,ButtonCheck);
if DepressedButton <> -1
then begin
ButtonCheck := ToolCollection^.At(DepressedButton);
ButtonCheck^.ButtonState := Up;
ToolCollection^.AtPut(DepressedButton,ButtonCheck);
end;
DepressedButton := ButtonCount;
end;
InvalidateRect(HWindow,nil,false);
SendMessage(HWindow,tb_buttonhit,0,0);
end;
end;
end.